home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 12 / Cream of the Crop 12 (Part II) / Cream of the Crop 12 (Part II).iso / BBS / SEMS101.ZIP / SEMS.BAS next >
Encoding:
BASIC Source File  |  1995-05-16  |  23.4 KB  |  670 lines
  1.   '***********************************************************************
  2.   '** Program Name: Squish EchoMail Snoop Program (SEMS)                **
  3.   '**       Author: R.J. (Bob) Ross                                     **
  4.   '** Date Started: April 25th, 1995                                    **
  5.   '**      Version: 1.00  - completed May 1st, 1995                     **
  6.   '**      Version: 1.01  - completed May 16th, 1995                    **              **
  7.   '**                                                                   **
  8.   '**      Purpose: To read selected Squish EchoMail areas and make a   **
  9.   '**               text output file containing EchoMail messages       **
  10.   '**               based on selection criteria supplied in a SEMS      **
  11.   '**               configuration file.                                 **
  12.   '**                                                                   **
  13.   '**     Language: Microsoft QuickBASIC 4.5                            **
  14.   '**    Libraries: Crescent Software Inc - QuickPak Professional       **
  15.   '**                                                                   **
  16.   '***********************************************************************
  17.   
  18.     DEFINT A-Z
  19.     DECLARE FUNCTION CurrentDate$ ()
  20.     DECLARE FUNCTION Date2Num% (D$)
  21.     DECLARE SUB EndPgm ()
  22.     DECLARE FUNCTION Exist% (FileName$)
  23.     DECLARE SUB Help ()
  24.     DECLARE FUNCTION MonthName$ (Month%)
  25.     DECLARE FUNCTION MsgDate$ (DateMsgWritten&)
  26.     DECLARE FUNCTION MsgTime$ (DateMsgWritten&)
  27.     DECLARE FUNCTION Num2Date$ (Days%)
  28.     DECLARE FUNCTION QInstrB (Start%, Source$, Search$)
  29.     DECLARE FUNCTION QPTrim$ (Work$)
  30.     DECLARE FUNCTION QPValI% (Work$)
  31.     DECLARE SUB SquishBase (SqFile$, NumMsgs%, TotSize&)
  32.     DECLARE SUB WordWrap (X$, Wide, LeftMargin)
  33.   
  34.     CLS
  35.   
  36.     ON ERROR GOTO Bomb
  37.   
  38.     DIM Snoop$(1 TO 20)
  39.     DIM LookFor$(1 TO 20)
  40.   
  41.     CONST False = 0
  42.     CONST True = NOT False
  43.   
  44.     Apend% = False
  45.     Snoop% = 0
  46.     SquishCfg% = False
  47.     CurrentDays% = Date2Num%(DATE$)
  48.     DaysBack% = 0
  49.     LongMsg% = False
  50.     LookFor% = 0
  51.     FlagMsg% = False
  52.     UseDate% = CurrentDays% - DaysBack%
  53.   
  54.     IF COMMAND$ = "" THEN
  55.         CALL Help
  56.         END
  57.     END IF
  58.   
  59.     CmdLine$ = UCASE$(COMMAND$)
  60.     P% = INSTR(CmdLine$, "-C")  ' -C  Config file
  61.     IF P% THEN
  62.         Temp$ = MID$(CmdLine$, P% + 2)
  63.         P% = INSTR(Temp$, " ")
  64.         IF P% THEN
  65.             ConFigFile$ = LEFT$(Temp$, P% - 1)
  66.         ELSE
  67.             ConFigFile$ = Temp$
  68.         END IF
  69.     ELSE
  70.         CALL Help
  71.         END
  72.     END IF
  73.   
  74.     IF INSTR(CmdLine$, "-A") THEN Apend% = True
  75.   
  76.     CONST Version = "SEMS V1.01"
  77.     Dt$ = CurrentDate$
  78.   
  79.     PRINT Dt$; TIME$; " SEMS Begin "; Version
  80.   
  81.     IF NOT Exist%(ConFigFile$) THEN
  82.       ' no config file
  83.         PRINT Dt$; TIME$; " SEMS ConfigFile "; ConFigFile$; " not found."
  84.         CALL EndPgm
  85.         END
  86.     END IF
  87.   
  88.   'Type definitions for the Squish Message Base Files
  89.   
  90.     TYPE SQIDX  ' .SQI file: one of these per message (12 bytes)
  91.         OFFST  AS LONG
  92.         UmsgID AS LONG
  93.         HASH   AS LONG
  94.     END TYPE
  95.   
  96.     TYPE SQBASE ' .SQD database header (256 bytes): 1 per .SQD file
  97.         SLEN    AS INTEGER
  98.         RSVD1   AS INTEGER
  99.         NUMMSG  AS LONG         ' No of msgs in area
  100.         HiMsg   AS LONG         ' Highest msg number (same as NUMMSG)
  101.         SKIPMSG AS LONG         ' # of msgs to protect from autoKill
  102.         HIWATER AS LONG         ' Highwatermark
  103.         UID     AS LONG         ' # of next UMSGID to use
  104.         BASEID  AS STRING * 80  ' Name (incl path) of this message base
  105.         FBEGIN  AS LONG         ' Offset to 1st frame
  106.         FLAST   AS LONG         ' Offset to last frame
  107.         FFBEGIN AS LONG         ' Offset to 1st free frame
  108.         FFLAST  AS LONG         ' Offset to last free frame
  109.         FEND    AS LONG         ' Offset to end of file
  110.         MAXMSGS AS LONG         ' # of msgs to keep
  111.         MAXDAYS AS INTEGER      ' # of days to keep msgs for
  112.         SZSQHDR AS INTEGER      ' Size of SQHDR (32 bytes)
  113.     END TYPE
  114.   
  115.     TYPE SQHDR
  116.         ID     AS LONG
  117.         NEXTF  AS LONG
  118.         PREVF  AS LONG
  119.         FLEN   AS LONG
  120.         MSGLEN AS LONG
  121.         CLEN   AS LONG
  122.         FTYP   AS INTEGER
  123.         RSVD   AS INTEGER
  124.     END TYPE
  125.   
  126.     TYPE SQMESSAGE              ' The message Header, as it appears in a Squish area
  127.         ATTRIB      AS STRING * 4               'Message Attribute Flag
  128.         From        AS STRING * 36              'From Name with trailing nulls
  129.         Dest        AS STRING * 36              'To Name with trailing nulls
  130.         Subj        AS STRING * 72              'Message subject with trailing nulls
  131.         OrigZone    AS INTEGER  'Origination Zone
  132.         OrigNet     AS INTEGER  'Origination Net
  133.         OrigNode    AS INTEGER  'Origination Node
  134.         OrigPoint   AS INTEGER  'Origination Point
  135.         DestZone    AS INTEGER  'Destination Zone
  136.         DestNet     AS INTEGER  'Destination Net
  137.         DestNode    AS INTEGER  'Destination Node
  138.         DestPoint   AS INTEGER  'Destination Point
  139.         DateWritten AS LONG     'DOS-ST date/time STAMP
  140.         DateArrived AS LONG     'DOS-ST date/time STAMP
  141.         UTCofs      AS INTEGER  'Not Used
  142.         ReplyTo     AS LONG     'UMSGID of message this replies to
  143.         Replies     AS STRING * 36              '36 bytes for reply array
  144.         UmsgID      AS LONG     'UMSGID is only used if the MSGUID Bit is
  145.       '       set in the ATTRIBUTE Field
  146.         DateMsg     AS STRING * 20              'ASCII Z Date
  147.     END TYPE
  148.   
  149.   
  150.   'End Type definitions for the Squish message base files
  151.   
  152.     DIM IDX AS SQIDX
  153.     DIM MBase AS SQBASE
  154.     DIM Mhdr AS SQHDR
  155.     DIM SqMsg AS SQMESSAGE
  156.   
  157.     OPEN ConFigFile$ FOR INPUT AS #5
  158.     PRINT Dt$; TIME$; " SEMS Parsing "; ConFigFile$
  159.     DO UNTIL EOF(5)
  160. ParseCfg:
  161.         DO UNTIL EOF(5)
  162.             LINE INPUT #5, Record$
  163.             Record$ = UCASE$(LTRIM$(Record$))
  164.             IF LEFT$(Record$, 1) = ";" THEN EXIT DO
  165.           
  166.             IF LEFT$(Record$, 5) = "SNOOP" THEN
  167.                 Snoop% = Snoop% + 1
  168.                 IF Snoop% > 20 THEN
  169.                   'do nothing
  170.                 ELSE
  171.                     P% = INSTR(Record$, " ")
  172.                     IF P% THEN
  173.                         Snoop$(Snoop%) = QPTrim$(MID$(Record$, P%))
  174.                         PRINT Dt$; TIME$; " SEMS Snoop at Node "; Snoop$(Snoop%)
  175.                     END IF
  176.                 END IF
  177.             END IF
  178.           
  179.             IF LEFT$(Record$, 10) = "OUTPUTFILE" THEN
  180.                 P% = INSTR(Record$, " ")
  181.                 IF P% THEN
  182.                     OutPutFile$ = QPTrim$(MID$(Record$, P%))
  183.                     PRINT Dt$; TIME$; " SEMS Output File is "; OutPutFile$
  184.                     IF Apend% THEN
  185.                         OPEN OutPutFile$ FOR APPEND AS #3
  186.                     ELSE
  187.                         OPEN OutPutFile$ FOR OUTPUT AS #3
  188.                     END IF
  189.                     PRINT #3, Dt$; TIME$; " SEMS Begin "; Version
  190.                 END IF
  191.               
  192.             END IF
  193.           
  194.             IF LEFT$(Record$, 8) = "DAYSBACK" THEN
  195.                 P% = INSTR(Record$, " ")
  196.                 IF P% THEN
  197.                     DaysBack% = VAL(MID$(Record$, P%))
  198.                     UseDate% = CurrentDays% - DaysBack%
  199.                     PRINT Dt$; TIME$; " SEMS Looking back "; DaysBack%; " day(s)."
  200.                 END IF
  201.             END IF
  202.           
  203.             IF LEFT$(Record$, 7) = "LOOKFOR" THEN
  204.                 LookFor% = LookFor% + 1
  205.                 IF LookFor% > 20 THEN
  206.                   'do nothing
  207.                 ELSE
  208.                     P% = INSTR(Record$, " ")
  209.                     IF P% THEN
  210.                         LookFor$(LookFor%) = QPTrim$(MID$(Record$, P%))
  211.                     END IF
  212.                 END IF
  213.             END IF
  214.           
  215.             IF LEFT$(Record$, 9) = "SQUISHCFG" THEN
  216.                 P% = INSTR(Record$, " ")
  217.                 IF P% THEN
  218.                     SquishCfg$ = QPTrim$(MID$(Record$, P%))
  219.                     SquishCfg% = True
  220.                     PRINT Dt$; TIME$; " SEMS Using "; SquishCfg$
  221.                     OPEN SquishCfg$ FOR INPUT AS #4
  222. SqCfg:
  223.                     DO UNTIL EOF(4)
  224.                         DO UNTIL EOF(4)
  225.                             LINE INPUT #4, Record$
  226.                             Record$ = LTRIM$(UCASE$(Record$))
  227.                             IF LEFT$(Record$, 1) = ";" THEN EXIT DO
  228.                             IF LEFT$(Record$, 8) = "ECHOAREA" THEN
  229.                                 P% = INSTR(Record$, " ")
  230.                                 IF P% THEN
  231.                                     Temp1$ = LTRIM$(MID$(Record$, P%))
  232.                                 END IF
  233.                                 P% = INSTR(Temp1$, " ")
  234.                                 IF P% THEN
  235.                                     EchoTag$ = LEFT$(Temp1$, P% - 1)
  236.                                     Temp2$ = LTRIM$(MID$(Temp1$, P%))
  237.                                 END IF
  238.                                 P% = INSTR(Temp2$, " ")
  239.                                 IF P% THEN
  240.                                     SqFile$ = LEFT$(Temp2$, P% - 1)
  241.                                     PRINT Dt$; TIME$; " SEMS Echo "; EchoTag$
  242.                                     FoundMsgs% = 0
  243.                                     GOSUB ProcMsgFiles
  244.                                     PRINT Dt$; TIME$; " SEMS Found"; FoundMsgs%; "Msgs"
  245.                                     IF FoundMsgs% THEN
  246.                                         PRINT #3,
  247.                                         PRINT #3, STRING$(79, 223)
  248.                                     END IF
  249.                                     PRINT #3, Dt$; TIME$; " SEMS Found"; FoundMsgs%; "Msgs in "; EchoTag$
  250.                                 END IF
  251.                             ELSE EXIT DO
  252.                             END IF
  253.                         LOOP
  254.                     LOOP
  255.                 END IF
  256.             END IF
  257.           
  258.             IF LEFT$(Record$, 8) = "ECHOAREA" AND NOT SquishCfg% THEN
  259.                 P% = INSTR(Record$, " ")
  260.                 IF P% THEN
  261.                     Temp1$ = LTRIM$(MID$(Record$, P%))
  262.                 END IF
  263.                 P% = INSTR(Temp1$, " ")
  264.                 IF P% THEN
  265.                     EchoTag$ = LEFT$(Temp1$, P% - 1)
  266.                     Temp2$ = LTRIM$(MID$(Temp1$, P%))
  267.                 END IF
  268.                 P% = INSTR(Temp2$, " ")
  269.                 IF P% THEN
  270.                     SqFile$ = LEFT$(Temp2$, P% - 1)
  271.                 ELSE SqFile$ = Temp2$
  272.                     PRINT Dt$; TIME$; " SEMS Echo "; EchoTag$
  273.                     FoundMsgs% = 0
  274.                     GOSUB ProcMsgFiles
  275.                     PRINT Dt$; TIME$; " SEMS Found"; FoundMsgs%; "Msgs"
  276.                     IF FoundMsgs% THEN
  277.                         PRINT #3,
  278.                         PRINT #3, STRING$(79, 223)
  279.                     END IF
  280.                     PRINT #3, Dt$; TIME$; " SEMS Found"; FoundMsgs%; "Msgs in "; EchoTag$
  281.                 END IF
  282.             END IF
  283.           
  284.         LOOP
  285.     LOOP
  286.     PRINT Dt$; TIME$; " SEMS End "; Version
  287.     PRINT #3, Dt$; TIME$; " SEMS End "; Version
  288.     CLOSE
  289.     IF Exist%("SEMS.$$$") THEN KILL "SEMS.$$$"
  290.     IF Exist%("SEMS.$$1") THEN KILL "SEMS.$$1"
  291.     END
  292.   
  293. Bomb:
  294.     IF ERR = 14 THEN
  295.       'out of string space'
  296.         a$ = ""
  297.         a$ = "**** Message text is too large for SEMS to process! ****" + STR$(Mhdr.MSGLEN)
  298.         PRINT Dt$; TIME$; " SEMS Found a message to large to process. "; Mhdr.MSGLEN
  299.         RESUME NEXT
  300.     END IF
  301.     IF ERR = 64 THEN
  302.         PRINT #3, Dt$; TIME$; " SEMS Bad file name "; SqFile$; ".SQD"
  303.         PRINT Dt$; TIME$; " SEMS Bad file name "; SqFile$; ".SQD"
  304.         IF SquishCfg% THEN
  305.             RESUME SqCfg
  306.         ELSE
  307.             RESUME ParseCfg
  308.         END IF
  309.     END IF
  310.     PRINT Dt$; TIME$; " SEMS Program abended with error "; ERR
  311.     END
  312.   
  313. ProcMsgFiles:
  314.     IF NOT Exist%(SqFile$ + ".SQI") THEN
  315.         PRINT Dt$; TIME$; " SEMS "; SqFile$; ".SQI "; "NOT found."
  316.         PRINT #3, Dt$; TIME$; " SEMS "; SqFile$; ".SQI "; "NOT found."
  317.         RETURN
  318.     END IF
  319.     OPEN SqFile$ + ".SQI" FOR RANDOM SHARED AS #1 LEN = 12
  320.     OPEN SqFile$ + ".SQD" FOR BINARY SHARED AS #2
  321.   
  322.     GET #2, 1, MBase
  323.     PRINT Dt$; TIME$; " SEMS Highest message ="; MBase.HiMsg
  324.   
  325.     FOR X% = 1 TO MBase.HiMsg
  326.         GET #1, X%, IDX
  327.         MsgOffst& = IDX.OFFST + 1 + LEN(Mhdr)
  328.         GET #2, IDX.OFFST + 1, Mhdr
  329.         GET #2, MsgOffst&, SqMsg
  330.         ReceiveDays% = 0
  331.         MsgDays% = Date2Num%(MsgDate$(SqMsg.DateWritten))
  332.         IF SqMsg.DateArrived THEN
  333.             ReceiveDays% = Date2Num%(MsgDate$(SqMsg.DateArrived))
  334.         END IF
  335.         IF MsgDays% >= UseDate% OR ReceiveDays% >= UseDate% THEN
  336.             Temp$ = MsgDate$(SqMsg.DateWritten)
  337.             Dy$ = MID$(Temp$, 4, 2)
  338.             Mo$ = MonthName$(VAL(LEFT$(Temp$, 2)))
  339.             Yr$ = RIGHT$(Temp$, 2)
  340.             SqMsg.DateMsg = Dy$ + " " + Mo$ + " " + Yr$
  341.             IF ReceiveDays% THEN
  342.                 Temp$ = MsgDate$(SqMsg.DateArrived)
  343.                 Dy$ = MID$(Temp$, 4, 2)
  344.                 Mo$ = MonthName$(VAL(LEFT$(Temp$, 2)))
  345.                 Yr$ = RIGHT$(Temp$, 2)
  346.                 DtArrived$ = Dy$ + " " + Mo$ + " " + Yr$
  347.             END IF
  348.             SEEK #2, MsgOffst&
  349.             IF Mhdr.MSGLEN > 20000 THEN
  350.                 LongMsg% = True
  351.                 Remainder% = 0
  352.                 a$ = ""
  353.                 Sems1% = Mhdr.MSGLEN \ 2
  354.                 Remainder% = Mhdr.MSGLEN MOD 2
  355.                 Sems2% = Sems1% + Remainder%
  356.                 IF Exist%("SEMS.$$1") THEN KILL "SEMS.$$1"
  357.                 OPEN "SEMS.$$1" FOR BINARY AS #6
  358.                 a$ = INPUT$(Sems1%, #2)
  359.                 GOSUB CheckStrings
  360.                 PUT #6, 1, a$
  361.                 a$ = ""
  362.                 SEEK #2, MsgOffst& + (Sems1%)
  363.                 a$ = INPUT$(Sems2%, #2)
  364.                 GOSUB CheckStrings
  365.                 FOR S% = 1 TO Snoop%
  366.                     Position% = 0
  367.                     Orig% = QInstrB(-1, a$, "* Origin: ")
  368.                     IF Orig% THEN
  369.                         Position% = QInstrB(-1, MID$(a$, Orig%), Snoop$(S%))
  370.                         IF Position% THEN
  371.                             EXIT FOR
  372.                         END IF
  373.                     END IF
  374.                 NEXT
  375.               
  376.                 PUT #6, , a$
  377.                 a$ = ""
  378.               
  379.                 CLOSE 6
  380.               
  381.             ELSE
  382.                 LongMsg% = False
  383.               
  384.                 a$ = INPUT$(Mhdr.MSGLEN, #2)
  385.                 GOSUB CheckStrings
  386.                 FOR S% = 1 TO Snoop%
  387.                     Position% = 0
  388.                     Orig% = QInstrB(-1, a$, "* Origin: ")
  389.                     IF Orig% THEN
  390.                         Position% = QInstrB(-1, MID$(a$, Orig%), Snoop$(S%))
  391.                         IF Position% THEN
  392.                             EXIT FOR
  393.                         END IF
  394.                     END IF
  395.                 NEXT
  396.               
  397.             END IF
  398.           
  399.             IF Snoop% = 0 THEN
  400.                 Position% = True
  401.             END IF
  402.           
  403.             IF Position% THEN
  404.                 Position% = 0
  405.               
  406.                 IF Exist%("SEMS.$$$") THEN KILL "SEMS.$$$"
  407.                 OPEN "SEMS.$$$" FOR BINARY AS #8
  408.               
  409.                 IF LongMsg% THEN
  410.                     GOSUB FormatLongText
  411.                 ELSE
  412.                     GOSUB FormatText
  413.                 END IF
  414.               
  415.                 TagNode$ = "┌─ " + EchoTag$ + " " + Snoop$(S%) + " "
  416.                 LSqMsgFm% = 6 + LEN(SqMsg.From)
  417.                 LSqMsgDt% = LEN(SqMsg.DateMsg)
  418.                 FoundMsgs% = FoundMsgs% + 1
  419.                 PRINT #3,
  420.                 PRINT #3, STRING$(79, 223)
  421.                 PRINT #3,
  422.                 PRINT #3, TagNode$;
  423.                 PRINT #3, STRING$(77 - LEN(TagNode$), 196); "┐"
  424.                 PRINT #3, "│ Written: "; SqMsg.DateMsg;
  425.                 PRINT #3, TAB(78); "│"
  426.                 PRINT #3, "│ Arrived: ";
  427.                 IF ReceiveDays% THEN
  428.                     PRINT #3, DtArrived$;
  429.                 END IF
  430.                 PRINT #3, TAB(78); "│"
  431.                 PRINT #3, "│    From: "; QPTrim$(SqMsg.From);
  432.                 PRINT #3, TAB(78); "│"
  433.                 PRINT #3, "│      To: "; QPTrim$(SqMsg.Dest);
  434.                 PRINT #3, TAB(78); "│"
  435.                 PRINT #3, "│    Subj: "; QPTrim$(SqMsg.Subj);
  436.                 PRINT #3, TAB(78); "│"
  437.                 IF FlagMsg% THEN
  438.                     FlagMsg% = False
  439.                     PRINT #3, "└"; STRING$(34, 196); "**LOOK**"; STRING$(34, 196); "┘"
  440.                 ELSE
  441.                     PRINT #3, "└"; STRING$(76, 196); "┘"
  442.                 END IF
  443.               
  444.                 OPEN "SEMS.$$$" FOR INPUT AS #8
  445.                 DO UNTIL EOF(8)
  446.                     LINE INPUT #8, text$
  447.                     IF MID$(text$, 1, 1) = CHR$(1) THEN
  448.                         MID$(text$, 1, 1) = "@"
  449.                     END IF
  450.                     IF LEFT$(text$, 3) = "---" THEN
  451.                         MID$(text$, 1, 3) = "+++"
  452.                     END IF
  453.                     IF LEFT$(text$, 10) = " * Origin:" THEN
  454.                         MID$(text$, 2, 1) = "+"
  455.                     END IF
  456.                     IF LEN(text$) > 80 THEN
  457.                         CALL WordWrap(text$, 80, 1)
  458.                     ELSE
  459.                         PRINT #3, text$
  460.                     END IF
  461.                 LOOP
  462.                 CLOSE 8
  463.             END IF
  464.         END IF
  465.     NEXT
  466.     MBase.HiMsg = 0
  467.     CLOSE 1, 2
  468.     RETURN
  469.   
  470. FormatLongText:
  471.     OPEN "sems.$$1" FOR BINARY AS #6
  472.     SEEK #6, 1
  473.     a$ = INPUT$(Sems1%, #6)
  474.     FOR a% = 1 TO LEN(a$)
  475.         IF MID$(a$, a%, 1) = CHR$(1) AND MID$(a$, a% + 1, 3) <> "EOT" THEN
  476.             P% = a%
  477.         END IF
  478.     NEXT
  479.     IF P% THEN a$ = MID$(a$, P%)
  480.     IF LEFT$(a$, 7) = CHR$(1) + "MSGID:" THEN
  481.         P% = INSTR(9, a$, " ")
  482.         IF P% THEN
  483.             a$ = MID$(a$, P% + 10)
  484.         END IF
  485.     END IF
  486.     IF LEFT$(a$, 7) = CHR$(1) + "REPLY:" THEN
  487.         P% = INSTR(9, a$, " ")
  488.         IF P% THEN
  489.             a$ = MID$(a$, P% + 10)
  490.         END IF
  491.     END IF
  492.     PUT #8, 1, a$
  493.     a$ = ""
  494.   
  495.     SEEK #6, Sems1%
  496.     a$ = INPUT$(Sems2%, #6)
  497.     P% = INSTR(a$, "SEEN-BY: ")
  498.     IF P% THEN a$ = LEFT$(a$, P% - 1)
  499.   
  500.     L% = LEN(SqMsg)
  501.     a$ = MID$(a$, L%)
  502.   
  503.     IF Snoop% = 0 THEN
  504.         P% = QInstrB(-1, a$, "(")
  505.         IF P% THEN
  506.             S% = 1
  507.             Temp$ = MID$(a$, P%)
  508.             P% = INSTR(Temp$, ")")
  509.             IF P% THEN Snoop$(S%) = LEFT$(Temp$, P%)
  510.         ELSE
  511.             S% = 1
  512.             Snoop$(S%) = "(Missing * Origin)"
  513.         END IF
  514.     END IF
  515.     PUT #8, , a$
  516.     a$ = ""
  517.     CLOSE 8
  518.     LongMsg% = False
  519.     RETURN
  520.   
  521. FormatText:
  522.     P% = INSTR(a$, "SEEN-BY: ")
  523.     IF P% THEN a$ = LEFT$(a$, P% - 1)
  524.     IF NOT LongMsg% THEN
  525.         L% = LEN(SqMsg)
  526.         a$ = MID$(a$, L%)
  527.     END IF
  528.     IF Snoop% = 0 THEN
  529.         P% = QInstrB(-1, a$, "(")
  530.         IF P% THEN
  531.             S% = 1
  532.             Temp$ = MID$(a$, P%)
  533.             P% = INSTR(Temp$, ")")
  534.             IF P% THEN Snoop$(S%) = LEFT$(Temp$, P%)
  535.         ELSE
  536.             S% = 1
  537.             Snoop$(S%) = "(Missing * Origin)"
  538.         END IF
  539.     END IF
  540.     P% = 0
  541.     FOR a% = 1 TO LEN(a$)
  542.         IF MID$(a$, a%, 1) = CHR$(1) AND MID$(a$, a% + 1, 3) <> "EOT" THEN
  543.           'MID$(a$, a%, 1) = "*"
  544.             P% = a%
  545.         END IF
  546.     NEXT
  547.     IF P% THEN a$ = MID$(a$, P%)
  548.     IF LEFT$(a$, 7) = CHR$(1) + "MSGID:" THEN
  549.         P% = INSTR(9, a$, " ")
  550.         IF P% THEN
  551.             a$ = MID$(a$, P% + 10)
  552.         END IF
  553.     END IF
  554.     IF LEFT$(a$, 7) = CHR$(1) + "REPLY:" THEN
  555.         P% = INSTR(9, a$, " ")
  556.         IF P% THEN
  557.             a$ = MID$(a$, P% + 10)
  558.         END IF
  559.     END IF
  560.     PUT #8, 1, a$
  561.     a$ = ""
  562.     CLOSE 8
  563.     RETURN
  564.   
  565. CheckStrings:
  566.     IF LookFor% THEN
  567.         FOR LF% = 1 TO LookFor%
  568.             P% = INSTR(UCASE$(a$), LookFor$(LF%))
  569.             IF P% THEN
  570.                 FlagMsg% = True
  571.                 EXIT FOR
  572.             END IF
  573.         NEXT
  574.     END IF
  575.     RETURN
  576.  
  577.     FUNCTION CurrentDate$ STATIC
  578.         Dt$ = DATE$
  579.         Month$ = MonthName$(VAL(LEFT$(Dt$, 2)))
  580.         CurrentDate$ = "  " + MID$(Dt$, 4, 2) + " " + Month$ + " "
  581.     END FUNCTION
  582.  
  583.     SUB EndPgm
  584.         SHARED Dt$
  585.         PRINT Dt$; TIME$; " SEMS End "; Version
  586.     END SUB
  587.  
  588.     SUB Help
  589.         Temp1$ = "Squish EchoMail Snoop Program - " + Version
  590.         Temp2$ = "Freeware"
  591.         Temp3$ = "by R.J. (Bob) Ross"
  592.         Temp4$ = "SysOp - RJ's Byteline BBS - FidoNet 1:134/75"
  593.         CLS
  594.         PRINT
  595.         PRINT TAB(40 - LEN(Temp1$) \ 2); Temp1$
  596.         PRINT TAB(40 - LEN(Temp2$) \ 2); Temp2$
  597.         PRINT TAB(40 - LEN(Temp3$) \ 2); Temp3$
  598.         PRINT TAB(40 - LEN(Temp4$) \ 2); Temp4$
  599.         PRINT STRING$(79, 196)
  600.         PRINT "Purpose:  To read selected Squish EchoMail areas and make a text output file"
  601.         PRINT "          containing EchoMail messages based on selection criteria supplied"
  602.         PRINT "          in a SEMS configuration file."
  603.         PRINT STRING$(79, 196)
  604.         PRINT "Switches:"
  605.         PRINT "          -Cdrive:\path\Sems.cfg  [connfiguration file]"
  606.         PRINT "          -A [optional - Appends output to an existing file]"
  607.         PRINT
  608.         PRINT
  609.         PRINT
  610.         PRINT
  611.       
  612.     END SUB
  613.  
  614.     FUNCTION MsgDate$ (DateMsgWritten&)
  615.       ' Code thanks to Don Bly
  616.       '
  617.       '
  618.         Da% = DateMsgWritten& AND &H1F&
  619.         Mo% = (DateMsgWritten& AND &H1E0&) \ &H20
  620.         Yr% = (DateMsgWritten& AND &HFE00&) \ &H200 + 1980
  621.       
  622.         Mo$ = LTRIM$(STR$(Mo%))
  623.         IF Mo% < 10 THEN Mo$ = "0" + Mo$
  624.         Da$ = LTRIM$(STR$(Da%))
  625.         IF Da% < 10 THEN Da$ = "0" + Da$
  626.         Yr$ = LTRIM$(STR$(Yr%))
  627.         MsgDate$ = Mo$ + "/" + Da$ + "/" + Yr$
  628.       
  629.     END FUNCTION
  630.  
  631.     FUNCTION MsgTime$ (DateMsgWritten&)
  632.       
  633.       'Code thanks to Don Bly
  634.       '
  635.       'The time function does not work properly when it hits a negative
  636.       'DateMsgWritten& number and I have no clue why.  However, SEMS does not
  637.       'use the MsgTime.  I've left the code in in case someone wants to fiddle
  638.       'with it
  639.       '
  640.         Hr% = (DateMsgWritten& AND &HF8000000) \ &H8000000
  641.         Mi% = (DateMsgWritten& AND &H7E00000) \ &H200000
  642.         Se% = (((DateMsgWritten& AND &H1F0000) \ &H10000) AND &H1F&) * 2
  643.       
  644.         Hr$ = LTRIM$(STR$(Hr%))
  645.         IF Hr% < 10 THEN Hr$ = "0" + Hr$
  646.         Mi$ = LTRIM$(STR$(Mi%))
  647.         IF Mi% < 10 THEN Mi$ = "0" + Mi$
  648.         Se$ = LTRIM$(STR$(Se%))
  649.         IF Se% < 10 THEN Se$ = "0" + Se$
  650.         MsgTime$ = Hr$ + ":" + Mi$ + ":" + Se$
  651.       
  652.     END FUNCTION
  653.  
  654.     SUB WordWrap (X$, Wide, LeftMargin) STATIC
  655.       
  656.         DO WHILE LEN(X$)        ' Loop while we have text
  657.           ' find a place to break the line
  658.             Pointer% = Wide + 1
  659.             DO UNTIL MID$(X$, Pointer%, 1) = " " OR Pointer% = 1 OR Pointer% > LEN(X$)
  660.                 Pointer% = Pointer% - 1
  661.             LOOP
  662.           ' handle unbreakable text
  663.             IF Pointer% = 1 THEN Pointer% = Wide + 1
  664.             PRINT #3, TAB(LeftMargin%); LEFT$(X$, Pointer% - 1) ' dump the line
  665.             X$ = MID$(X$, Pointer% + 1)
  666.         LOOP
  667.       
  668.     END SUB
  669.  
  670.